home *** CD-ROM | disk | FTP | other *** search
/ Festival Card Factory / Festival Card Factory.iso / graphwin.pas < prev    next >
Pascal/Delphi Source File  |  1995-12-25  |  11KB  |  405 lines
  1. unit GraphWin;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, StdCtrls, Buttons, ColorGrd, Menus, Printers, ClipBrd, Dialogs,
  8.   ExtCtrls;
  9.  
  10. type
  11.   TDrawingTool = (dtLine, dtRectangle, dtEllipse, dtRoundRect);
  12.  
  13.   TForm1 = class(TForm)
  14.     ToolBar: TPanel;
  15.     LineButton: TSpeedButton;
  16.     RectangleButton: TSpeedButton;
  17.     EllipseButton: TSpeedButton;
  18.     RoundRectButton: TSpeedButton;
  19.     PenButton: TSpeedButton;
  20.     BrushButton: TSpeedButton;
  21.     PenBar: TPanel;
  22.     BrushBar: TPanel;
  23.     SolidPen: TSpeedButton;
  24.     DashPen: TSpeedButton;
  25.     DotPen: TSpeedButton;
  26.     DashDotPen: TSpeedButton;
  27.     DashDotDotPen: TSpeedButton;
  28.     ClearPen: TSpeedButton;
  29.     SolidBrush: TSpeedButton;
  30.     ClearBrush: TSpeedButton;
  31.     HorizontalBrush: TSpeedButton;
  32.     VerticalBrush: TSpeedButton;
  33.     FDiagonalBrush: TSpeedButton;
  34.     BDiagonalBrush: TSpeedButton;
  35.     CrossBrush: TSpeedButton;
  36.     DiagCrossBrush: TSpeedButton;
  37.     PenColor: TColorGrid;
  38.     BrushColor: TColorGrid;
  39.     PenWidth: TScrollBar;
  40.     PenSize: TLabel;
  41.     StatusBar: TPanel;
  42.     OriginPanel: TPanel;
  43.     CurrentPanel: TPanel;
  44.     ScrollBox1: TScrollBox;
  45.     Image: TImage;
  46.     MainMenu1: TMainMenu;
  47.     File1: TMenuItem;
  48.     New1: TMenuItem;
  49.     Open1: TMenuItem;
  50.     Save1: TMenuItem;
  51.     Saveas1: TMenuItem;
  52.     Print1: TMenuItem;
  53.     N1: TMenuItem;
  54.     Exit1: TMenuItem;
  55.     Edit1: TMenuItem;
  56.     Copy1: TMenuItem;
  57.     Paste1: TMenuItem;
  58.     OpenDialog1: TOpenDialog;
  59.     SaveDialog1: TSaveDialog;
  60.     Cut1: TMenuItem;
  61.     SpeedButton1: TSpeedButton;
  62.     Label1: TLabel;
  63.     Edit2: TEdit;
  64.     paint: TSpeedButton;
  65.     procedure LineButtonClick(Sender: TObject);
  66.     procedure RectangleButtonClick(Sender: TObject);
  67.     procedure EllipseButtonClick(Sender: TObject);
  68.     procedure RoundRectButtonClick(Sender: TObject);
  69.     procedure IMAGEMouseDown(Sender: TObject; Button: TMouseButton;
  70.       Shift: TShiftState; X, Y: Integer);
  71.     procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
  72.       Shift: TShiftState; X, Y: Integer);
  73.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  74.       Y: Integer);
  75.     procedure PenButtonClick(Sender: TObject);
  76.     procedure BrushButtonClick(Sender: TObject);
  77.     procedure PenWidthChange(Sender: TObject);
  78.     procedure SetPenStyle(Sender: TObject);
  79.     procedure PenColorClick(Sender: TObject);
  80.     procedure SetBrushStyle(Sender: TObject);
  81.     procedure BrushColorClick(Sender: TObject);
  82.     procedure FormCreate(Sender: TObject);
  83.     procedure Exit1Click(Sender: TObject);
  84.     procedure Print1Click(Sender: TObject);
  85.     procedure Open1Click(Sender: TObject);
  86.     procedure Save1Click(Sender: TObject);
  87.     procedure Saveas1Click(Sender: TObject);
  88.     procedure New1Click(Sender: TObject);
  89.     procedure Copy1Click(Sender: TObject);
  90.     procedure Paste1Click(Sender: TObject);
  91.     procedure Cut1Click(Sender: TObject);
  92.     procedure SpeedButton1Click(Sender: TObject);
  93.     procedure paintClick(Sender: TObject);
  94.   private
  95.     { Private declarations }
  96.   public
  97.     { Public declarations }
  98.     Drawing: Boolean;
  99.     Origin, MovePt: TPoint;
  100.     DrawingTool: TDrawingTool;
  101.     CurrentFile: string;
  102.     procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
  103.   end;
  104.  
  105. var
  106.   Form1: TForm1;
  107.   writ:Boolean;
  108.   bX,BY:INTEGER;
  109.  
  110. implementation
  111.  
  112. uses BMPDlg;
  113.  
  114. {$R *.DFM}
  115.  
  116. procedure TForm1.LineButtonClick(Sender: TObject);
  117. begin
  118.   DrawingTool := dtLine;
  119. end;
  120.  
  121. procedure TForm1.RectangleButtonClick(Sender: TObject);
  122. begin
  123.   DrawingTool := dtRectangle;
  124. end;
  125.  
  126. procedure TForm1.EllipseButtonClick(Sender: TObject);
  127. begin
  128.   DrawingTool := dtEllipse;
  129. end;
  130.  
  131. procedure TForm1.RoundRectButtonClick(Sender: TObject);
  132. begin
  133.   DrawingTool := dtRoundRect;
  134. end;
  135.  
  136. procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
  137. begin
  138.   with Image.Canvas do
  139.   begin
  140.     Pen.Mode := AMode;
  141.     case DrawingTool of
  142.       dtLine: begin
  143.                 MoveTo(TopLeft.X, TopLeft.Y);
  144.                 LineTo(BottomRight.X, BottomRight.Y);
  145.               end;
  146.       dtRectangle: Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y);
  147.       dtEllipse: Ellipse(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y);
  148.       dtRoundRect: RoundRect(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y,
  149.         (TopLeft.X - BottomRight.X) div 2, (TopLeft.Y - BottomRight.Y) div 2);
  150.     end;
  151.   end;
  152. end;
  153.  
  154. procedure TForm1.IMAGEMouseDown(Sender: TObject; Button: TMouseButton;
  155.   Shift: TShiftState; X, Y: Integer);
  156. begiN
  157.     if writ then
  158.   begin
  159.      if edit2.text<>'' then
  160.      BEGIN
  161.        image.canvas.textout(Bx,by-4,edit2.text);
  162.        EDIT2.TEXT:='';
  163.      END;
  164.      edit2.left:=x;
  165.      Edit2.top:=y+34;
  166.      Edit2.visible:=true;
  167.      activecontrol:=Edit2;
  168.      bX:=X;
  169.      BY:=Y;
  170.   end;
  171.   If paint.Down=True then
  172.      begin
  173.      Image.Canvas.Brush.Color:=BrushColor.ForegroundColor;
  174.      Image.Canvas.FloodFill(x,y,clBlack,fsBorder);
  175.      end
  176.   else
  177.   begin
  178.   Drawing := True;
  179.   Image.Canvas.MoveTo(X, Y);
  180.   Origin := Point(X, Y);
  181.   MovePt := Origin;
  182.   OriginPanel.Caption := Format('Origin: (%d, %d)', [X, Y]);
  183.   end;
  184. end;
  185.  
  186. procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  187.   Shift: TShiftState; X, Y: Integer);
  188. begin
  189.   if Drawing then
  190.     DrawShape(Origin, Point(X, Y), pmCopy);
  191.   Drawing := False;
  192. end;
  193.  
  194. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  195.   Y: Integer);
  196. begin
  197.   if Drawing then
  198.   begin
  199.     DrawShape(Origin, MovePt, pmNotXor);
  200.     MovePt := Point(X, Y);
  201.     DrawShape(Origin, MovePt, pmNotXor);
  202.   end;
  203.   CurrentPanel.Caption := Format('Current: (%d, %d)', [X, Y]);
  204. end;
  205.  
  206. procedure TForm1.PenButtonClick(Sender: TObject);
  207. begin
  208.   PenBar.Visible := PenButton.Down;
  209. end;
  210.  
  211. procedure TForm1.BrushButtonClick(Sender: TObject);
  212. begin
  213.   BrushBar.Visible := BrushButton.Down;
  214. end;
  215.  
  216. procedure TForm1.PenWidthChange(Sender: TObject);
  217. begin
  218.   Image.Canvas.Pen.Width := PenWidth.Position;
  219.   PenSize.Caption := IntToStr(PenWidth.Position);
  220. end;
  221.  
  222. procedure TForm1.SetPenStyle(Sender: TObject);
  223. begin
  224.   with Image.Canvas.Pen do
  225.   begin
  226.     if Sender = SolidPen then Style := psSolid
  227.     else if Sender = DashPen then Style := psDash
  228.     else if Sender = DotPen then Style := psDot
  229.     else if Sender = DashDotPen then Style := psDashDot
  230.     else if Sender = DashDotDotPen then Style := psDashDotDot
  231.     else if Sender = ClearPen then Style := psClear;
  232.   end;
  233. end;
  234.  
  235. procedure TForm1.PenColorClick(Sender: TObject);
  236. begin
  237.   Image.Canvas.Pen.Color := PenColor.ForegroundColor;
  238. end;
  239.  
  240. procedure TForm1.SetBrushStyle(Sender: TObject);
  241. begin
  242.   with Image.Canvas.Brush do
  243.   begin
  244.     if Sender = SolidBrush then Style := bsSolid
  245.     else if Sender = ClearBrush then Style := bsClear
  246.     else if Sender = HorizontalBrush then Style := bsHorizontal
  247.     else if Sender = VerticalBrush then Style := bsVertical
  248.     else if Sender = FDiagonalBrush then Style := bsFDiagonal
  249.     else if Sender = BDiagonalBrush then Style := bsBDiagonal
  250.     else if Sender = CrossBrush then Style := bsCross
  251.     else if Sender = DiagCrossBrush then Style := bsDiagCross;
  252.   end;
  253. end;
  254.  
  255. procedure TForm1.BrushColorClick(Sender: TObject);
  256. begin
  257.   Image.Canvas.Brush.Color := BrushColor.ForegroundColor;
  258. end;
  259.  
  260. procedure TForm1.FormCreate(Sender: TObject);
  261. var
  262.   Bitmap: TBitmap;
  263. begin
  264.   Bitmap := TBitmap.Create;
  265.   Bitmap.Width := form1.width-20;
  266.   Bitmap.Height := form1.height-40;
  267.   Image.Picture.Graphic := Bitmap;
  268. end;
  269.  
  270. procedure TForm1.Exit1Click(Sender: TObject);
  271. begin
  272.   Close;
  273. end;
  274.  
  275. procedure TForm1.Print1Click(Sender: TObject);
  276. begin
  277.   with Printer do
  278.   begin
  279.     BeginDoc;
  280.     Canvas.Draw(0, 0, Image.Picture.Graphic);
  281.     EndDoc;
  282.   end;
  283. end;
  284.  
  285. procedure TForm1.Open1Click(Sender: TObject);
  286. begin
  287.   if OpenDialog1.Execute then
  288.   begin
  289.     CurrentFile := OpenDialog1.FileName;
  290.     Image.Picture.LoadFromFile(CurrentFile);
  291.   end;
  292. end;
  293.  
  294. procedure TForm1.Save1Click(Sender: TObject);
  295. begin
  296.   if CurrentFile <> '' then
  297.     Image.Picture.SaveToFile(CurrentFile)
  298.   else SaveAs1Click(Sender);
  299. end;
  300.  
  301. procedure TForm1.Saveas1Click(Sender: TObject);
  302. begin
  303.   if SaveDialog1.Execute then
  304.   begin
  305.     CurrentFile := SaveDialog1.FileName;
  306.     Save1Click(Sender);
  307.   end;
  308. end;
  309.  
  310. procedure TForm1.New1Click(Sender: TObject);
  311. var
  312.   Bitmap: TBitmap;
  313. begin
  314.   with NewBMPForm do
  315.   begin
  316.     ActiveControl := WidthEdit;
  317.     WidthEdit.Text := IntToStr(Image.Picture.Graphic.Width);
  318.     HeightEdit.Text := IntToStr(Image.Picture.Graphic.Height);
  319.     if ShowModal <> idCancel then
  320.     begin
  321.       Bitmap := TBitmap.Create;
  322.       Bitmap.Width := StrToInt(WidthEdit.Text);
  323.       Bitmap.Height := StrToInt(HeightEdit.Text);
  324.       Image.Picture.Graphic := Bitmap;
  325.       CurrentFile := '';
  326.     end;
  327.   end;
  328. end;
  329.  
  330. procedure TForm1.Copy1Click(Sender: TObject);
  331. begin
  332.   Clipboard.Assign(Image.Picture);
  333. end;
  334.  
  335. procedure TForm1.Paste1Click(Sender: TObject);
  336. var
  337.   Bitmap: TBitmap;
  338. begin
  339.   if Clipboard.HasFormat(CF_BITMAP) then
  340.   begin
  341.     Bitmap := TBitmap.Create;
  342.     try
  343.       Bitmap.Assign(Clipboard);
  344.       Image.Canvas.Draw(0, 0, Bitmap);
  345.     finally
  346.       Bitmap.Free;
  347.     end;
  348.   end;
  349. end;
  350.  
  351. procedure TForm1.Cut1Click(Sender: TObject);
  352. var
  353.   ARect: TRect;
  354. begin
  355.   Copy1Click(Sender);
  356.   with Image.Canvas do
  357.   begin
  358.     CopyMode := cmWhiteness;
  359.     ARect := Rect(0, 0, Image.Width, Image.Height);
  360.     CopyRect(ARect, Image.Canvas, ARect);
  361.     CopyMode := cmSrcCopy;
  362.   end;
  363. end;
  364.  
  365. procedure TForm1.SpeedButton1Click(Sender: TObject);
  366. begin
  367.      if Speedbutton1.down then
  368.      begin
  369.      image.cursor:=criBeam;
  370.      writ:=true;
  371.      end
  372.      else
  373.      begin
  374.      if edit2.text<>'' then
  375.      IMAGE.canvas.textout(BX,BY,edit2.text);
  376.      EDIT2.TEXT:='';
  377.      edit2.visible:=false;
  378.      writ:=false;
  379.      image.cursor:=crDefault;
  380.      end;
  381. end;
  382.  
  383. procedure TForm1.paintClick(Sender: TObject);
  384. begin
  385.      If paint.Down=true then
  386.      begin
  387.      image.cursor:=crMultiDrag;
  388.      penButton.Enabled:=False;
  389.      PenBar.Visible:=False;
  390.      BrushButton.Enabled:=false;
  391.      BrushBar.Visible:=true;
  392.      end
  393.      else
  394.      If paint.Down=false then
  395.      begin
  396.      image.cursor:=crDefault;
  397.      PenButton.Enabled:=true;
  398.      PenBar.Visible:=PenButton.Down;
  399.      BrushButton.Enabled:=true;
  400.      BrushBar.Visible:=brushButton.Down;
  401.      end;
  402. end;
  403.  
  404. end.
  405.